home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / basement.srx next >
Text File  |  2000-02-29  |  3KB  |  152 lines
  1. /********************************\
  2. ** Basement v1.0 for Solitarexx **
  3. **    by Michal Szafranski      **
  4. \********************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = 'Basement'
  8. wintex = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDTEXT 4 42 tex 6
  11. ADDBUTTON 12 10 "Abort"
  12. ADDTEXT 14 42 tex 6
  13. SELECTGUI 1
  14.  
  15. SCREENSIZE 5 0 3 20
  16. DO i = 0 TO 3
  17.     NEWSTACK 3 8+3 0 0 i 10 0 10
  18.     stack.i = RESULT
  19.     NEWSTACK 3 8+1 0 2 i 10 0 10
  20.     j = i+5
  21.     stack.j = RESULT
  22.     NEWSTACK 1 8   0 1 i 10
  23.     base.i = RESULT
  24. END
  25. NEWSTACK 4 8+3 0 0 4 10 0 10
  26. stack.4 = RESULT
  27. NEWSTACK 5 8+1 0 2 4 10 0 10
  28. stack.9 = RESULT
  29. NEWSTACK 2 8   1 1 4 10
  30. deck = RESULT
  31. ADDCARDS deck SHUFFLED
  32.  
  33. DO FOREVER
  34.     ACTION
  35.     PARSE VAR RESULT act rest
  36.     IF act = 1 THEN EXIT
  37.     IF act = 3 THEN CALL GAME
  38. END
  39.  
  40. GAME:
  41.     CLEANUP deck
  42.     SETGADGET 14 STR tex
  43.     SELECTGUI 4
  44.     sel = 0
  45.     fin = 4
  46.     b = 0
  47.     bopen = 0
  48.     order = 0
  49.     CARDSELECT deck 1
  50.     PARSE VAR RESULT k base .
  51.     MOVECARDS deck base.0 REVERSE
  52.     kbase.k = base.0
  53.     stc. = 5
  54.     stc.4 = 4
  55.     stc.9 = 4
  56.     j=0
  57.     DO i=0 TO 50
  58.         CARDSELECT deck 1
  59.         PARSE VAR RESULT k war .
  60.         IF war = base THEN DO
  61.             b = b+1
  62.             mm = base.b
  63.             kbase.k = mm
  64.         END
  65.         ELSE DO
  66.             stc.j = stc.j -1
  67.             mm = stack.j
  68.         END
  69.         MOVECARDS deck mm REVERSE
  70.         IF stc.j = 0 THEN j=j+1
  71.     END
  72.     DO FOREVER
  73.         ACTION
  74.         PARSE VAR RESULT act stack sid card
  75.         SELECT
  76.         WHEN act = 1 THEN EXIT
  77.         WHEN act = 2 & sel = 0 & card>0 & sid>2 THEN sel = stack
  78.         WHEN act = 2 & sel = 0 & card>0 & sid=2 & bopen = 1 THEN sel = stack
  79.         WHEN act = 2 & sel > 0 THEN DO
  80.             IF sel = stack THEN DO
  81.                 sid = 1
  82.                 CARDSELECT sel 1
  83.                 PARSE VAR RESULT k .
  84.                 stack = kbase.k
  85.             END
  86.             SELECT
  87.                 WHEN sid = 1 THEN CALL DOBASE
  88.                 WHEN sid = 2 THEN CALL DOHELP
  89.                 WHEN sid = 3 THEN CALL DOSTACKS
  90.                 OTHERWISE ERRBEEP
  91.             END
  92.             sel = 0
  93.             IF bopen = 0 THEN DO
  94.                 CARDSELECT stack.4 1
  95.                 IF RESULT = '' THEN bopen = 1
  96.                 CARDSELECT stack.9 1
  97.                 IF RESULT = '' THEN bopen = 1
  98.             END
  99.         END
  100.         WHEN act = 3 THEN DO
  101.             SELECTGUI 1
  102.             RETURN
  103.         END
  104.         OTHERWISE ERRBEEP
  105.         END
  106.     END
  107. RETURN
  108. DOHELP:
  109.     CARDSELECT stack 1
  110.     IF RESULT = '' THEN MOVECARDS sel stack
  111.     ELSE ERRBEEP
  112. RETURN
  113. DOSTACKS:
  114.     CARDSELECT sel 0 RELATIVE
  115.     PARSE VAR RESULT kolors wars xx
  116.     CARDSELECT stack 1
  117.     PARSE VAR RESULT kolor war xx
  118.     IF kolor = '' THEN DO
  119.         w = 1
  120.         kolor = kolors
  121.     END
  122.     ELSE w = ABS(war-wars)
  123.     IF (w=1 | w=12) & kolor = kolors THEN MOVECARDS sel stack
  124.     ELSE ERRBEEP
  125. RETURN
  126. DOBASE:
  127.     IF order~= 0 THEN CALL CHBASE
  128.     ELSE DO
  129.         order = 1
  130.         CALL CHBASE
  131.         IF ok = 1 THEN DO
  132.             order = -1
  133.             CALL CHBASE
  134.         END
  135.         IF ok = 1 THEN order = 0
  136.     END
  137.     IF ok=0 THEN DO
  138.         fin = fin +1
  139.         MOVECARDS sel stack
  140.         IF fin = 52 THEN SETGADGET 14 STR wintex
  141.     END
  142.     ELSE ERRBEEP
  143. RETURN
  144. CHBASE:
  145.     CARDSELECT sel 1
  146.     PARSE VAR RESULT kolors wars .
  147.     CARDSELECT stack 1
  148.     PARSE VAR RESULT kolor war .
  149.     w = war - wars
  150.     ok = ~(kolor = kolors & (w = order | -w = 12*order))
  151. RETURN
  152.